home *** CD-ROM | disk | FTP | other *** search
/ Cream of the Crop 26 / Cream of the Crop 26.iso / program / p063b9s.zip / UNIT / DISPLAY.PAS < prev    next >
Pascal/Delphi Source File  |  1997-01-15  |  15KB  |  468 lines
  1. UNIT Display;
  2. {╔══════════════════════════════════════════════════════════════════════════╗}
  3. {║ Routines to display information               Last changed: 15.01.97  SA ║}
  4. {║                                                                          ║}
  5. {║                         (C) Copyright 1989-96 by                         ║}
  6. {║       Dan Wulff, Jens Sandalgaard, Steen Christensen & S¢ren Ager        ║}
  7. {║                                                                          ║}
  8. {║ This source may not be given to anybody, without the written permission  ║}
  9. {║ from The Portal Team.                                                    ║}
  10. {╚══════════════════════════════════════════════════════════════════════════╝}
  11. {$I POPDEFS.INC}
  12.  
  13. INTERFACE
  14.  
  15. USES Use32, OpWindow, ApTimer,
  16.      PoPTypes, Globals;
  17.  
  18. TYPE
  19.   PGauge=^TGauge;
  20.   TGauge=Object(StackWindow)
  21.     CONSTRUCTOR Init(y, Col: Byte; Header: S40; AMax: LongInt);
  22.     PROCEDURE Update(Num: LongInt);
  23.   PRIVATE
  24.     Max : LongInt;
  25.   END;
  26.  
  27.   PWait=^TWait;
  28.   TWait=Object(StackWindow)
  29.     CurState,
  30.     Col  : Byte;
  31.     Text : S80;
  32.     Timer : EventTimer;
  33.  
  34.     CONSTRUCTOR Init(y, ACol: Byte; AText: S80);
  35.     PROCEDURE Animate;
  36.   END;
  37.  
  38. PROCEDURE Tell(VAR w: WindowPtr; CONST S, Header: S80; YPos, ColorLevel: Byte);
  39. PROCEDURE ShowAbout;
  40. PROCEDURE UpdateFrames;
  41. PROCEDURE UpdateNetMailFlag;
  42. FUNCTION  SendableData(OutListPtr: POutList): Boolean;
  43. PROCEDURE UpdateOutboundWindow;
  44. FUNCTION  CorrectAttribute(Level: Byte; Current, Marked: Boolean): Byte;
  45. FUNCTION  WaitForAction(Secs: LongInt): WORD;
  46. PROCEDURE UpdateCallsWindow(w: WindowPtr; n: Byte);
  47. PROCEDURE AboutToday;
  48. PROCEDURE UpdateStatusWindow;
  49.  
  50. IMPLEMENTATION
  51.  
  52. USES Dos, OpFrame, OpCrt, OpDate, OpString,
  53.      Com, Keyboard,
  54. {$IFNDEF OS2}
  55.      Macro,
  56. {$ENDIF}
  57.      OproUtil, StrUtil, Util, MTask, OpusMsg;
  58.  
  59.  
  60. {=== TGauge ===}
  61.  
  62.   CONSTRUCTOR TGauge.Init(y,Col:Byte; Header:S40; AMax:LongInt);
  63.   BEGIN
  64.     IF AMax=0 THEN Fail;
  65.     INHERITED InitCustom(14,y,65,y,Cfg.Color[Col],wClear+wSaveContents+wBordered);
  66.     IF Header<>'' THEN wFrame.AddHeader(' '+Header+' ',heTC);
  67.     IF Cfg.Screen.ExplodingWin THEN EnableExplosions(10);
  68.     wFRame.AddShadow(shBR,shSeeThru);
  69.     SetCursor(cuHidden);
  70.     Draw;
  71.     Max:=AMax;
  72.     Update(0);
  73.   END;
  74.  
  75.   PROCEDURE TGauge.Update(Num:LongInt);
  76.   VAR
  77.     pct:Real;
  78.     pcti:Byte;
  79.     s:S50;
  80.  
  81.     FUNCTION FillTab (i:Byte): CHAR;
  82.     BEGIN
  83.       CASE i OF
  84.         0 : FillTab:=#219;
  85.         1 : FillTab:=#178;
  86.         2 : FillTab:=#177;
  87.         3 : FillTab:=#176;
  88.       END;
  89.     END;
  90.  
  91.   BEGIN
  92.     ActivateWrite;
  93.     pct:=200.0*Round(Num)/Round(Max);
  94.     pcti:=Trunc(pct);
  95.     IF pcti>3 THEN s:=charstr(FillTab(3),Trunc(pcti DIV 4)) ELSE s:='';
  96.     IF Length(s)<50 THEN s:=s+FillTab(pcti mod 4)+charstr(#219,49-length(s));
  97.     wfasttext(s,1,2);
  98.     DeActivateWrite;
  99.   END;
  100.  
  101.  
  102. {=== TWait ===}
  103.  
  104.   CONSTRUCTOR TWait.Init(y, ACol: Byte; AText: S80);
  105.   BEGIN
  106.     INHERITED InitCustom(37-Length(AText) div 2, y, 43+Length(AText) div 2, y,
  107.                          Cfg.Color[ACol], wClear+wSaveContents+wBordered);
  108.     SetCursor(cuHidden);
  109.     wFrame.AddHeader(' Please wait ',heTC);
  110.     IF Cfg.Screen.ExplodingWin THEN EnableExplosions(10);
  111.     wFrame.AddShadow(shBR, shSeeThru);
  112.     Draw;
  113.     NewTimer(Timer, -18);
  114.     Col:=ACol;
  115.     Text:=AText;
  116.     CurState:=0;
  117.     Animate;
  118.   END;
  119.  
  120.   PROCEDURE TWait.Animate;
  121.   CONST
  122.     StateMax = 3;
  123.     StateChar : ARRAY[0..StateMax] of Char = ('|','/','-','\');
  124.   BEGIN
  125.     IF TimerExpired(Timer) THEN
  126.     BEGIN
  127.       wFastCenter(Text+'  '+StateChar[CurState], 1, Cfg.Color[Col].TextColor);
  128.       IF CurState=StateMax THEN CurState:=0 ELSE Inc(CurState);
  129.       NewTimer(Timer, 6);
  130.     END;
  131.   END;
  132.  
  133.  
  134. {=== ===}
  135.  
  136.   PROCEDURE Tell(VAR w: WindowPtr; CONST S, Header: S80; YPos, ColorLevel: Byte);
  137.   BEGIN
  138.     MyWin(w,38-Length(s) div 2,YPos,42+Length(s) div 2,YPos+2, ColorLevel, Header, True);
  139.     w^.wFastText(s,1,2);
  140.   END;
  141.  
  142.   PROCEDURE ShowAbout;
  143.   VAR
  144.     Start : Byte;
  145.     About : WindowPtr;
  146.   BEGIN
  147.     Start:=(ScreenHeight DIV 2)-4;
  148.     MyWin(About, 24, Start, 56, Start+8, 2, 'About', True);
  149.     WITH About^ DO
  150.     BEGIN
  151.       wFastCenter('Portal of Power',2,Cfg.Color[2].HighLightColor);
  152.       wFastCenter('Version '+Ver,3,Cfg.Color[2].TextColor);
  153.       wFastCenter('(C) Copyright 1989-97 by',5,Cfg.Color[2].TextColor);
  154.       wFastCenter('The Portal Team',6,Cfg.Color[2].TextColor);
  155.     END;
  156.     REPEAT
  157.       GiveUpTime;
  158.     UNTIL PoPKeyPressed OR ComPort^.KeyPressed;
  159.     KillWindow(About);
  160.     IF PoPKeyPressed THEN PoPReadKeyWord;
  161.   END;
  162.  
  163.   PROCEDURE UpdateFrames;
  164.   BEGIN
  165.     If InLogWin Then
  166.     BEGIN
  167.       ActivityWindow^.wFrame.SetFrameType(DblWindowFrame);
  168.       OutboundWindow^.wFrame.SetFrameType(SglWindowFrame);
  169.     End Else
  170.     BEGIN
  171.       ActivityWindow^.wFrame.SetFrameType(SglWindowFrame);
  172.       OutboundWindow^.wFrame.SetFrameType(DblWindowFrame);
  173.     END;
  174.     ActivityWindow^.wFrame.UpDateFrame;
  175.     OutboundWindow^.wFrame.UpDateFrame;
  176. {$IFNDEF OS2}
  177.     WriteMacroStatus;
  178. {$ENDIF}
  179.     UpdateNetMailFlag;
  180.   END;
  181.  
  182.   PROCEDURE UpdateNetMailFlag;
  183.   VAR
  184.     s           : S9;
  185.     HaveNetMail : Boolean;
  186.     f           : FILE OF Word;
  187.     HighMsg     : Word;
  188.     Sr          : SearchRec;
  189.   BEGIN
  190.     HaveNetMail:=False;
  191.     IF Cfg.MailScanner.NetMailDir<>'' THEN
  192.     BEGIN
  193.       FindFirst(Cfg.MailScanner.NetMailDir+'LASTREAD.*', Archive, Sr);
  194.       IF DOSError=0 THEN
  195.       BEGIN
  196.         Assign(f, Cfg.MailScanner.NetMailDir+Sr.Name);
  197.         FileMode:=ShareRead+ShareDenyNone;
  198.         Reset(f);
  199.         IF IOResult=0 THEN
  200.         BEGIN
  201.           Read(f, HighMsg); IF IOResult=0 THEN ;
  202.           Close(f);
  203.           HaveNetMail:=(GetHighestMsg(Cfg.MailScanner.NetMailDir)>HighMsg);
  204.         END;
  205.       END;
  206.       FindClose(Sr);
  207.     END;
  208.     IF HaveNetMail THEN
  209.       s:=' NetMail '
  210.     ELSE
  211.       IF InLogWin THEN s:='═════════' ELSE s:='─────────';
  212.     ActivityWindow^.ActivateWrite;
  213.     ActivityWindow^.ChangeHeader(2, s);
  214.     ActivityWindow^.DeActivateWrite;
  215.   END;
  216.  
  217.   FUNCTION  WaitForAction(Secs: LongInt): Word;
  218.   VAR
  219.     t: EventTimer;
  220.     InKey:WORD;
  221.   BEGIN
  222.     InKey:=0;
  223.     NewTimerSecs(t, Secs);
  224.     REPEAT
  225.       GiveUpTime;
  226.     UNTIL PoPKeyPressed OR ComPort^.KeyPressed OR (TimerExpired(t));
  227.     IF (NOT ComPort^.KeyPressed) AND (PopKeyPressed) THEN InKey:=PopReadKeyWord;
  228.     WaitForAction:=InKey;
  229.   END;
  230.  
  231.   FUNCTION  CorrectAttribute(Level:Byte; Current,Marked:Boolean):Byte;
  232.   BEGIN
  233.     WITH cfg.color[Level] DO
  234.     BEGIN
  235.       IF Current THEN
  236.       BEGIN
  237.         IF Marked THEN CorrectAttribute:=HighLightColor
  238.                   ELSE CorrectAttribute:=BlockColor;
  239.       END ELSE
  240.       BEGIN
  241.         IF Marked THEN CorrectAttribute:=SelFieldColor
  242.                   ELSE CorrectAttribute:=FieldColor;
  243.       END;
  244.     END;
  245.   END;
  246.  
  247.   FUNCTION SendableData(OutListPtr: POutList): Boolean;
  248.   VAR
  249.     s        : Boolean;
  250.     BaudRate : Word;
  251.   BEGIN
  252.     WITH OutListPtr^, CurrentEvent DO
  253.     BEGIN
  254.       IF (NC>=tries.busy) OR (BWZ>=tries.bad) OR (Closed) OR
  255.          ((MinMail>0) AND (Size<MinMail)) OR (DontCall) THEN
  256.         s:=False
  257.       ELSE
  258.       BEGIN
  259.         IF Cfg.Modem.BaudRate<Baud THEN BaudRate:=Cfg.Modem.BaudRate
  260.                                    ELSE BaudRate:=Baud;
  261.         IF ((MaxCost>0) AND (Cost>MaxCost)) THEN
  262.         BEGIN
  263.           s:=False;
  264.         END ELSE
  265.         BEGIN
  266.           s:=(Bits AND 8)<>0;  { Important }
  267.           IF typ AND etReceive=0 THEN        { Receive only }
  268.           BEGIN      { Crash }
  269.             s:=s OR (((Bits AND 4)<>0) AND ((Not NoCMail) OR (TimeIsBetween(OpenFrom, OpenTo)) OR
  270.                     ((Address.Zone=Cfg.Addresses[Cfg.MainAdrNum].Zone) AND (Cfg.ZMHStart+Cfg.ZMHEnd>0) AND
  271.                     TimeIsBetween(Cfg.ZMHStart,Cfg.ZMHEnd))));
  272.             IF (typ AND etCrash=0) THEN
  273.               s:=s OR ((((Bits AND 1)<>0) OR ((Bits AND 2)<>0)) AND
  274.                ((Not NoCMail) OR (TimeIsBetween(OpenFrom,OpenTo)) OR
  275.                 ((Address.Zone=Cfg.Addresses[Cfg.MainAdrNum].Zone) AND (Cfg.ZMHStart+Cfg.ZMHEnd>0)) AND
  276.                 TimeIsBetween(Cfg.ZMHStart,Cfg.ZMHEnd)));
  277.           END;
  278.         END;
  279.       END;
  280.       IF (Baud>Cfg.Modem.BaudRate) AND (NOT Cfg.FastCalls) THEN s:=False;
  281.       SendableData:=s AND Not Glued;
  282.     END;
  283.   END;
  284.  
  285.   PROCEDURE UpdateOutboundWindow;
  286.   VAR
  287.     b          : WORD;
  288.     s          : String;
  289.     Send       : Char;
  290.     Attr, i    : Byte;
  291.     OutListPtr : POutList;
  292.     OkToWrite  : Boolean;
  293.  
  294.     FUNCTION Star(B: Byte): Char;
  295.     BEGIN
  296.       IF (OutListPtr^.Bits AND B)<>0 THEN Star:='*' ELSE Star:=' ';
  297.     END;
  298.  
  299.   BEGIN
  300.     OutboundWindow^.ActivateWrite;
  301.     OutListPtr:=POutList(OutList^.Head);
  302.     MailToSend:=False;
  303.     OkToWrite:=False;
  304.     i:=0; Send:=' ';
  305.     REPEAT
  306.       IF OutListPtr=FLOutListPtr THEN OkToWrite:=True;
  307.       IF OkToWrite THEN INC(i);
  308.       IF OutListPtr<>Nil THEN
  309.       BEGIN
  310.         IF OutListPtr=CLOutListPtr THEN Attr:=Cfg.Color[1].BlockColor
  311.                                    ELSE Attr:=Cfg.Color[1].HighLightColor;
  312.         WITH OutListPtr^, CurrentEvent DO
  313.         BEGIN
  314.           IF Not Known THEN Send:='?' ELSE
  315.             IF Closed THEN Send:=#25 ELSE
  316.             BEGIN
  317.               IF (NC>=tries.busy) OR (BWZ>=tries.bad) THEN Send:='!' ELSE
  318.                 IF Glued THEN Send:=#1 ELSE
  319.                   IF SendableData(OutListPtr) THEN Send:='*' ELSE Send:='-';
  320.             END;
  321.           IF OkToWrite AND (i<5) THEN
  322.           BEGIN
  323.             s:=Address2Str(Address);
  324.             IF Baud<Cfg.Modem.BaudRate THEN b:=baud ELSE b:=Cfg.Modem.BaudRate;
  325.             s:=CPad(s,19)+Send+' '+Star(8)+Star(4)+Star(2)+Star(1)+Star(16)+' '+
  326.                  Star(32)+' '+Star(64)+' '+Star(128)+'  '+LongIntForm('###',FilesToSend)+
  327.                  ' '+LongIntForm('###', Age)+' '+LongIntForm('#####',(Size+512) DIV 1024);
  328.             IF (Send<>'?') AND (b<>0) THEN
  329.             BEGIN
  330.               s:=s+' '+TimeToTimeString('h:mm:ss',Trunc(Size DIV 230*2400 DIV b));
  331.             END ELSE
  332.               s:=s+'        ';
  333.             OutboundWindow^.wFastWrite(s,i+1,2,Attr);
  334.           END;
  335.         END;
  336.         OutListPtr:=POutList(OutList^.Next(OutListPtr));
  337.       END ELSE
  338.         IF i<5 THEN OutboundWindow^.wFastWrite(CharStr(' ',55),i+1,2,Cfg.Color[1].HighLightcolor);
  339.       IF Send='*' THEN MailToSend:=True;
  340.     UNTIL (OutListPtr=NIL) AND (i>4);
  341.     OutboundWindow^.DeActivateWrite;
  342.   END;
  343.  
  344.  
  345.   PROCEDURE UpdateCallsWindow(w:WindowPtr; n:Byte);
  346.   VAR
  347.     t1,i : Byte;
  348.     S  : String;
  349.   BEGIN
  350.     FOR t1:=1 TO 5 DO
  351.       WITH Data.Calls[n,t1] DO
  352.         IF Adr.Zone<>0 THEN
  353.         BEGIN
  354.           IF Adr.Zone=-1 THEN
  355.             s:=CharStr(' ',14)
  356.           ELSE
  357.             s:=CPad(Address2Str(Adr),14);
  358.           s:=s+CPad(Name,17)+TimeToTimeString('HH:mM',T);
  359.           IF ScreenHeight<=LinesForStat THEN i:=2 ELSE i:=1;
  360.           w^.wFastWrite(s,t1,2,Cfg.color[i].HighlightColor);
  361.         END;
  362.   END;
  363.  
  364.   PROCEDURE AboutToday;
  365.   VAR
  366.     Temp,
  367.     userwin : WindowPtr;
  368.     t       : LongInt;
  369.     D       : Word;
  370.  
  371.     PROCEDURE WriteLine(t1,t2: Word; t3: LongInt; y: Byte);
  372.     BEGIN
  373.        Temp^.wFastWrite(LongIntForm('#####',t1)+
  374.                         LongIntForm('#######',t2)+
  375.                         LongIntForm('############',t3)+
  376.                         LongIntForm('#######',t3 DIV D),
  377.                         y,16,Cfg.Color[2].HighLightColor);
  378.     END;
  379.  
  380.   BEGIN
  381.     MyWin(UserWin, 17, ScreenHeight-23-Byte(ScreenHeight>LinesForStat)*2, 63,
  382.                        ScreenHeight-17-Byte(ScreenHeight>LinesForStat)*2, 2, 'Last users',False);
  383.     WITH UserWin^, cfg.color[2] DO
  384.       FOR t:=1 TO 5 DO
  385.         IF data.users[t].Name <> '' THEN
  386.         BEGIN
  387.           wfastwrite(data.users[t].Name, t, 2, HighLightColor);
  388.           wfastwrite(TimeToTimeString('HH:mM',data.users[t].T), t, 40, HighLightColor);
  389.         END;
  390.     MyWin(Temp, 15, ScreenHeight-16-Byte(ScreenHeight>LinesForStat)*2, 65,
  391.                     ScreenHeight-7-Byte(ScreenHeight>LinesForStat)*2, 2, 'Activity report',False);
  392.     WITH Temp^, cfg.color[2] DO
  393.     BEGIN
  394.       wFastText('Today  Yesterday   Total  Average',1,16);
  395.       wfastText('User calls :', 2, 2);
  396.       wfastText('Mail calls :', 3, 2);
  397.       wfastText('Calls out  :', 4, 2);
  398.       wfastText('Successes  :', 5, 2);
  399.       wfastText('Call cost  :', 6, 2);
  400.       wfastText('Files in   :', 7, 2);
  401.       wfastText('Files out  :', 8, 2);
  402.     END;
  403.     IF StatRec^.Start.D<>0 THEN
  404.     BEGIN
  405.       D:=Today-StatRec^.Start.D;
  406.       Temp^.wFastWrite('('+DateToDateString('dd/mm-yy',StatRec^.Start.D)+')',1,3,Cfg.Color[2].HighlightColor);
  407.     END ELSE
  408.       D:=1;
  409.     IF D=0 THEN D:=1;
  410.     WITH StatRec^ DO
  411.     BEGIN
  412.       WriteLine(DayStat[0].bbssessions,DayStat[1].BbsSessions,Total.BBSSessions,2);
  413.       WriteLine(DayStat[0].mailsessions,DayStat[1].MailSessions,Total.MailSessions,3);
  414.       WriteLine(DayStat[0].callsout,DayStat[1].CallsOut,Total.CallsOut,4);
  415.       WriteLine(DayStat[0].callsgood,DayStat[1].CallsGood,Total.CallsGood,5);
  416.       WriteLine(DayStat[0].Cost,DayStat[1].Cost,Total.Cost,6);
  417.       WriteLine(DayStat[0].filesin,DayStat[1].FilesIn,Total.FilesIn,7);
  418.       WriteLine(DayStat[0].filesout,DayStat[1].FilesOut,Total.FilesOut,8);
  419.     END;
  420.     IF ScreenHeight<=LinesForStat THEN MyWin(CallsIn, 1, ScreenHeight-6, 40, ScreenHeight, 2, 'Last calls in', False);
  421.     UpdateCallsWindow(CallsIn, 1);
  422.     IF ScreenHeight<=LinesForStat THEN MyWin(CallsOut, 41, ScreenHeight-6, 80, ScreenHeight, 2, 'Last calls out', False);
  423.     UpdateCallsWindow(CallsOut, 2);
  424.     WaitForAction(20);
  425.     IF ScreenHeight<=LinesForStat THEN
  426.     BEGIN
  427.       KillWindow(CallsOut);
  428.       KillWindow(CallsIn);
  429.     END;
  430.     KillWindow(Temp);
  431.     KillWindow(UserWin);
  432.   END;
  433.  
  434.   PROCEDURE UpdateStatusWindow;
  435.   VAR
  436.     s : String;
  437.   BEGIN
  438.     WITH StatusWindow^ DO
  439.     BEGIN
  440.       ActivateWrite;
  441.       wfastwrite(LongIntForm('##',data.event)+'      ',3,11,Cfg.Color[1].HighLightColor);
  442.       s:=LongIntForm('##',cfg.modem.commport)+',';
  443.       IF ComPort^.Carrier THEN
  444.         s:=s+LongIntForm('#####',ComPort^.GetBaudRate)
  445.       ELSE
  446.         s:=s+LongIntForm('#####',Cfg.Modem.BaudRate);
  447.       wFastWrite(s,4,11,Cfg.Color[1].HighLightColor);
  448.       wFastWrite(CharStr(' ',8),5,11,Cfg.Color[1].HighLightColor);
  449.     END;
  450.     s:='';
  451.     IF Data.Event>0 THEN
  452.     BEGIN
  453.       WITH CurrentEvent DO
  454.       BEGIN
  455.         IF typ AND etRequests<>0 THEN s:=s+'R';
  456.         IF typ AND etUsers<>0 THEN s:=s+'U' ELSE s:=s+'M';
  457.         IF typ AND etReceive<>0 THEN s:=s+'Ro';
  458.         IF typ AND etCrash<>0 THEN s:=s+'Co';
  459.         IF typ AND etNoSend<>0 THEN s:=s+'Ns';
  460.         IF typ AND etDynamic<>0 THEN s:=s+'D';
  461.       END;
  462.     END ;
  463.     StatusWindow^.wFastWrite(s,5,11,Cfg.Color[1].HighLightColor);
  464.     StatusWindow^.DeActivateWrite;
  465.   END;
  466.  
  467. END.
  468.